perm filename TAX.F4[LIB,LCS]3 blob sn#146437 filedate 1975-02-15 generic text, type T, neo UTF8
00100	C***** INCOME TAX HELPER ******
00200	CC	DIMENSION WAGES(10),DIV(10),RINT(10),BINC(10),
00300	CC	1 CAS(10),SUPS(10),ROY(10),PENS(10),CAPG(10),SITR(10),
00400	CC	1 OTH(10),EBEX(10),RMED(20),TAXES(10),XOTH(10),CONTR(10),
00500	CC	1 TLOSS(10),RMIN(10),DOC(10),DOTH(10),RTAX(10),RMORT(10),
00600	CC	1 ROTH(10),OCONT(10),OCASH(10),UNION(10),RMOTH(10),WTAX(10)
00700	CC	1,ETAX(10),FICA(10)
00800		COMMON K,ACC,IOUT
00900		IOUT=5
01000	C****  -99=BACKUP  **************
01100	C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200	C  5=TTY  3=LPT
01300		ACC=-1
01400		TYPE 200
01500		ACCEPT 3,N
01600		IF(N.NE.'O')GO TO 60
01700	200	FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800		TYPE 85
01900		ACCEPT 4,NAME
02000		GO TO 201
02100	33	FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200	45	FORMAT('+ REAL ESTATE.'/)
02300	55	FORMAT('+ INSURANCE REIMBURSEMENT.'/)
02400	57	FORMAT('+ ALIMONY PAID.'/)
02500	58	FORMAT('+ UNION DUES.'/)
02600	59	FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
02700	60	FORMAT('+ TOTAL---   ',F10.2/)
02800		IF(N.NE.'H')GO TO 4
02900		TYPE 202
03000		CALL EXIT
03100	202	FORMAT(' ASK LCS FOR INFORMATION.')
03200	1	FORMAT(20F)
03300	2	FORMAT(F10.2/)
03400	3	FORMAT(A1)
03500	4	FORMAT(A5)
03600		I=' '
03700	
03800	601	FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03900		WRITE(IOUT,601)
04000		IF(ACC.EQ.0)GO TO 102
04100		TYPE 604
04200	604	FORMAT(' TO BACKUP TYPE -99 '/)
04300	600	FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
04400		CALL TYP(3,I)
04410		TYPE 600
04500		ACCEPT 3,MFS
04600	102	CALL TYP(7,I)
04700		WRITE(IOUT, 11)
04800	11	FORMAT('+ NUMBER OF EXEMPTIONS  ',$)
04900		CALL ADUP(EX)
05000		IF(EX.EQ.-99)GO TO 600
05100	1100	CALL TYP(9,I)
05200		WRITE(IOUT, 12)
05300	12	FORMAT('+ WAGES, ETC. (FROM W2 FORMS)  '/)
05400		CALL ADUP(WG)
05500		IF(WG.EQ.-99)GO TO 102
05600	103	CALL TYP(10,'A')
05700		WRITE(IOUT, 13)
05800	13	FORMAT('+ DIVIDENDS.'/)
05900		CALL ADUP(DT)
06000		IF(DT.EQ.-99)GO TO 102
06100		IF(DT.EQ.0)GO TO 105
06200	104	CALL TYP(10,'B')
06300		WRITE(IOUT, 14)
06400	14	FORMAT('+ DIVIDEND EXCLUSION.  ',$)
06500		CALL ADUP(DEX)
06600		IF(DEX.EQ.-99)GO TO 103
06700		TOTD=DT-DEX
06800		CALL TYP(10,'C')
06900		WRITE(IOUT, 15)TOTD
07000	15	FORMAT('+ TOTAL DIVIDENDS.  ',F11.2/)
07100	105	CALL TYP(11,I)
07200		WRITE(IOUT, 16)
07300	16	FORMAT('+ INTEREST INCOME.  '/)
07400		CALL ADUP(RT)
07500		IF(RT.EQ.-99)GO TO 104
07600	106	CALL TYP(12,I)
07700		WRITE(IOUT, 17)
07800	17	FORMAT('+ OTHER INCOME.'/)
07900	602	FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
08000		1' ***** TYPE -999 TO SKIP OVER SECTION AND RETURN TO PG.1'/)
08100		IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08200		WRITE(IOUT,602)
08300		CALL TYP(28,I)
08400		WRITE(IOUT, 18)
08500	18	FORMAT('+ BUSINESS INCOME-LOSS.'/)
08600		CALL ADUP(BI)
08700		IF(BI.EQ.-999)GO TO 1603
08800		IF(BI.EQ.-99)GO TO 105
08900	107	CALL TYP(29,I)
09000		WRITE(IOUT, 19)
09100	19	FORMAT('+ CAPITAL ASSETS.'/)
09200		CALL ADUP(CA)
09300		IF(CA.EQ.-99)GO TO 106
09400	108	CALL TYP(30,I)
09500		WRITE(IOUT, 20)
09600	20	FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09700		CALL ADUP(SU)
09800		IF(SU.EQ.-99)GO TO 107
09900	109	CALL TYP(31,I)
10000		WRITE(IOUT, 21)
10100	21	FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10200		CALL ADUP(RY)
10300		IF(RY.EQ.-99)GO TO 108
10400	110	CALL TYP(33,I)
10500		WRITE(IOUT, 22)
10600	22	FORMAT('+ PENSIONS, ETC.'/)
10700		CALL ADUP(PE)
10800		IF(PE.EQ.-99)GO TO 109
10900	111	CALL TYP(34,I)
11000		WRITE(IOUT, 23)
11100	23	FORMAT('+ 50% CAPITAL GAIN.'/)
11200		CALL ADUP(CP)
11300		IF(CP.EQ.-99)GO TO 110
11400	112	CALL TYP(35,I)
11500		WRITE(IOUT, 24)
11600	24	FORMAT('+ STATE INCOME TAX REFUNDS.'/)
11700		CALL ADUP(SI) 	
11800		IF(SI.EQ.-99)GO TO 111
11900	113	CALL TYP(36,I)
12000		WRITE(IOUT, 25)
12100	25	FORMAT('+ ALIMONY INCOME.  '/)
12200		CALL ADUP(ALM)
12300		IF(ALM.EQ.-99)GO TO 112
12400	114	CALL TYP(37,I)
12500		WRITE(IOUT, 26)
12600	26	FORMAT('+ OTHER.'/)
12700		CALL ADUP(OT)
12800		IF(OT.EQ.-99)GO TO 113
12900		CALL TYP(38,I)
13000		T38=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13100		WRITE(IOUT, 60)T38
13200	603	FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
13300		WRITE(IOUT,603)
13400	1603	CALL TYP(12,I)
13500		IF(BI.EQ.-999)BI=0
13600		WRITE(IOUT,60)T38
13700		CALL TYP(13,I)
13800		T13=WG+TOTD+RT+T38
13900		WRITE(IOUT, 60)T13
14000	115	CALL TYP(14,I)
14100		WRITE(IOUT, 27)
14200	27	FORMAT('+ ADJUSTMENTS TO INCOME'/)
14300	
14400		IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
14500		WRITE(IOUT,602)
14600		CALL TYP(39,I)
14700		WRITE(IOUT, 28)
14800	28	FORMAT('+ SICK PAY.  ',/)
14900		CALL ADUP(SICK)
15000		IF(SICK.EQ.-999)GO TO 1604
15100		IF(SICK.EQ.-99)GO TO 114
15200	116	CALL TYP(40,I)
15300		WRITE(IOUT, 29)
15400	29	FORMAT('+ MOVING EXPENSES.  ',/)
15500		CALL ADUP(RMEX)
15600		IF(RMEX.EQ.-99)GO TO 115
15700	117	CALL TYP(41,I)
15800		WRITE(IOUT, 30)
15900	30	FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16000		CALL ADUP(EB) 
16100		IF(EB.EQ.-99)GO TO 116
16200	118	CALL TYP(42,I)
16300		WRITE(IOUT, 31)
16400	31	FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN.  '/)
16500		CALL ADUP(SER)
16600		IF(SER.EQ.-99)GO TO 117
16700		CALL TYP(43,I)
16800		T43=SICK+RMEX+EB+SER
16900		WRITE(IOUT, 60)T43
17000	
17100		WRITE(IOUT,603)
17200	1604	CALL TYP(14,I)
17300		IF(SICK.EQ.-999)SICK=0
17400		WRITE(IOUT, 60)T43
17500		T15=T13-T43
17600		CALL TYP(15,I)
17700		WRITE(IOUT, 32)T15
17800	32	FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
17900		IF(T15.LT.10000.)CALL SMALL(T15)
18000		CALL STDED(T15)
18100		IF(ACC)WRITE(IOUT, 34)
18200	34	FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
18300		IF(ACC)ACCEPT 3,JIT
18400		IF(JIT.EQ.'N')GO TO 6900
18500	C*************************************
18600	119	WRITE(IOUT, 35)
18700	35	FORMAT(/' ***** GO TO SCHEDULE A *****')
18800		WRITE(IOUT, 36)
18900	36	FORMAT(/' ----- MEDICAL - DENTAL '/)
19000		IF(ACC.EQ.0)GO TO 3700
19100		CALL TYP(1,I)
19200		WRITE(IOUT, 37)
19300	37	FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
19400		CALL ADUP(RMI)
19500		IF(RMI.EQ.-99)GO TO 118
19600	3700	T1=RMI/2.
19700		IF(T1.GT.150.)T1=150.
19800		CALL TYP(1,I)
19900		WRITE(IOUT, 2)T1
20000	120	CALL TYP(2,I)
20100		WRITE(IOUT, 38)
20200	38	FORMAT('+ MEDICINE AND DRUGS. '/)
20300		CALL ADUP(RM) 
20400		IF(RM.EQ.-99)GO TO 119
20500		CALL TYP(3,I)
20600	61	FORMAT('+ 1% OF LINE 15-- ',F10.2/)
20700		ONP=T15/100.
20800		WRITE(IOUT, 61)ONP
20900		T4=RM-ONP
21000		IF(T4)T4=0
21100		CALL TYP(4,I)
21200		WRITE(IOUT, 2)T4
21300		CALL TYP(5,I)
21400		T5=RMI-T1
21500		IF(T5)T5=0
21600	62	FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
21700		WRITE(IOUT, 62)T5
21800		CALL TYP(6,I)
21900		WRITE(IOUT, 39)
22000	39	FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
22100	121	CALL TYP(6,'A')
22200		WRITE(IOUT, 40)
22300	40	FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
22400		CALL ADUP(DO)
22500		IF(DO.EQ.-99)GO TO 120
22600	122	CALL TYP(6,'B')
22700		WRITE(IOUT, 41)
22800	41	FORMAT('+ HOSPITALS.'/)
22900		CALL ADUP(HOSP)
23000		IF(HOSP.EQ.-99)GO TO 121
23100	123	CALL TYP(6,'C')
23200		WRITE(IOUT, 26)
23300		CALL ADUP(DOTH)
23400		IF(DOTH.EQ.-99)GO TO 122
23500		T7=T4+T5+DO+HOSP+DOTH
23600		CALL TYP(7,I)
23700		WRITE(IOUT, 60)T7
23800		T8=T15*.03
23900		CALL TYP(8,I)
24000		WRITE(IOUT, 2)T8
24100		T9=T7-T8
24200		IF(T9)T9=0
24300		CALL TYP(9,I)
24400		WRITE(IOUT, 2)T9
24500		T10=T9+T1
24600		CALL TYP(10,I)
24700		WRITE(IOUT, 60)T10
24800		CALL TYP(35,I)
24900		WRITE(IOUT, 60)T10
25000	
25100	43	FORMAT(/' ----- TAXES'/)
25200		WRITE(IOUT, 43)
25300	124	CALL TYP(11,I)
25400		WRITE(IOUT, 44)
25500	44	FORMAT('+ STATE AND LOCAL INCOME.'/)
25600		CALL ADUP(TA)
25700		IF(TA.EQ.-99)GO TO 123
25800	125	CALL TYP(12,I)
25900		WRITE(IOUT, 45)
26000		CALL ADUP(RX)
26100		IF(RX.EQ.-99)GO TO 124
26200	126	CALL TYP(13,I)
26300		WRITE(IOUT, 42)
26400	42	FORMAT('+ GASOLINE TAX (SEE TABLES)  '/)
26500		CALL ADUP(GTAX)
26600		IF(GTAX.EQ.-99)GO TO 125
26700	127	CALL TYP(14,I)
26800		WRITE(IOUT, 46)
26900	46	FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
27000		CALL ADUP(STAX)
27100		IF(STAX.EQ.-99)GO TO 126
27200	128	CALL TYP(15,I)
27300		WRITE(IOUT, 47)
27400	47	FORMAT('+ PERSONAL PROPERTY'/)
27500		CALL ADUP(PTAX)
27600		IF(PTAX.EQ.-99)GO TO 127
27700	129	CALL TYP(16,I)
27800		WRITE(IOUT, 26)
27900		CALL ADUP(XO)
28000		IF(XO.EQ.-99)GO TO 128
28100		CALL TYP(17,I)
28200		T17=TA+RX+GTAX+STAX+PTAX+XO
28300		WRITE(IOUT, 60)T17
28400		CALL TYP(36,I)
28500		WRITE(IOUT, 60)T17
28600	130	WRITE(IOUT, 48)
28700	48	FORMAT(/' ----- INTEREST EXPENSE'/)
28800		CALL TYP(18,I)
28900		WRITE(IOUT, 49)
29000	49	FORMAT('+ HOME MORTGAGE.'/)
29100		CALL ADUP(RMO)
29200		IF(RMO.EQ.-99)GO TO 129
29300	131	CALL TYP(19,I)
29400		WRITE(IOUT, 26)
29500		CALL ADUP(ROH)
29600		IF(ROH.EQ.-99)GO TO 130
29700		CALL TYP(20,I)	
29800		T20=RMO+ROH
29900		WRITE(IOUT, 60)T20
30000		CALL TYP(37,I)
30100		WRITE(IOUT, 60)T20
30200	
30300	132	WRITE(IOUT, 50)
30400	50	FORMAT(/' ----- CONTRIBUTIONS '/)
30500		CALL TYP(21,'A')
30600		WRITE(IOUT, 51)
30700	51	FORMAT('+ CASH CONTRIBUTIONS.'/)
30800		CALL ADUP(CO)
30900		IF(CO.EQ.-99)GO TO 131
31000	133	CALL TYP(21,'B')
31100		WRITE(IOUT, 26)
31200		CALL ADUP(OC)
31300		IF(OC.EQ.-99)GO TO 132
31400	134	CALL TYP(22,I)
31500		WRITE(IOUT, 510)
31600	510	FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
31700		CALL ADUP(OCA)
31800		IF(OCA.EQ.-99)GO TO 133
31900	135	CALL TYP(23,I)
32000		WRITE(IOUT, 52)
32100	52	FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
32200		CALL ADUP(PRIOR)
32300		IF(PRIOR.EQ.-99)GO TO 134
32400	136	CALL TYP(24,I)
32500		T24=PRIOR+OCA+OC+CO
32600		WRITE(IOUT, 60)T24
32700		CALL TYP(38,I)
32800		WRITE(IOUT, 60)T24
32900	137	WRITE(IOUT, 53)
33000	53	FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
33100		CALL TYP(25,I)
33200	54	FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
33300		WRITE(IOUT, 54)
33400		CALL ADUP(RLOSS)
33500		IF(RLOSS.EQ.-99)GO TO 135
33600		IF(RLOSS.EQ.0)GO TO 139
33700	138	CALL TYP(26,I)
33800		WRITE(IOUT, 55)
33900		CALL ADUP(RIR)
34000		IF(RIR.EQ.-99)GO TO 137
34100		CALL TYP(27,I)
34200		T27=RLOSS-RIR
34300		IF(T27)T27=0
34400		WRITE(IOUT, 60)T27
34500		T28=100.
34600		IF(T27.LT.T28)T28=T27
34700		CALL TYP(28,I)
34800		WRITE(IOUT, 2)T28
34900		T29=T27-T28
35000		CALL TYP(29,I)
35100		WRITE(IOUT, 60)T29
35200		CALL TYP(39,I)
35300		WRITE(IOUT, 60)T29
35400	139	WRITE(IOUT, 56)
35500	56	FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
35600		CALL TYP(30,I)
35700		WRITE(IOUT, 57)
35800		CALL ADUP(ALIMON)
35900		IF(ALIMON.EQ.-99)GO TO 138
36000	140	CALL TYP(31,I)
36100		WRITE(IOUT, 58)
36200		CALL ADUP(UN)
36300		IF(UN.EQ.-99)GO TO 139
36400	141	CALL TYP(32,I)
36500		WRITE(IOUT, 59)
36600		CALL ADUP(CAD)
36700		IF(CAD.EQ.-99)GO TO 140
36800	142	CALL TYP(33,I)
36900		WRITE(IOUT, 26)
37000		CALL ADUP(SOTH)
37100		IF(SOTH.EQ.-99)GO TO 141
37200		T34=ALIMONY+UN+CAD+SOTH
37300		CALL TYP(34,I)
37400		WRITE(IOUT, 60)T34
37500		CALL TYP(40,I)
37600		WRITE(IOUT, 60)T34
37700		WRITE(IOUT, 63)
37800	63	FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
37900		CALL TYP(35,I)
38000		WRITE(IOUT, 64)T10
38100	64	FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
38200		CALL TYP(36,I)
38300		WRITE(IOUT, 65)T17
38400	65	FORMAT('+ TOTAL TAXES.',F12.2/)
38500	650	FORMAT('+ TOTAL INTEREST.',F12.2/)
38600	66	FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
38700	67	FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
38800	68	FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
38900	69	FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
39000		CALL TYP(37,I)
39100		WRITE(IOUT, 650)T20
39200		CALL TYP(38,I)
39300		WRITE(IOUT, 66)T24
39400		CALL TYP(39,I)
39500		WRITE(IOUT, 67)T29
39600		CALL TYP(40,I)
39700		WRITE(IOUT, 68)T34
39800		CALL TYP(41,I)
39900		T41=T34+T29+T20+T17+T10
40000		WRITE(IOUT, 69)T41
40100	
40200		WRITE(IOUT,602)
40300	6900	CALL TYP(44,I)
40400		WRITE(IOUT,32)T15
40500		IF(JIT.NE.'Y')GO TO 6901
40600		CALL TYP(45,'A')
40700		WRITE(IOUT, 69)T41
40800	6901	T45B=T15*.15
40900		X=2000
41000		IF(MFS.EQ.'Y')X=1000
41100		IF(T45B.GT.X)T45B=X
41200		CALL TYP(45,'B')
41300		WRITE(IOUT, 69)T45B
41400		T46=T15-T41
41500		T46B=T15-T45B
41600		IF(JIT.NE.'Y')GO TO 6902
41700		CALL TYP(46,'A')
41800		WRITE(IOUT, 2)T46
41900	6902	CALL TYP(46,'B')
42000		WRITE(IOUT, 2)T46B
42100		CALL TYP(47,I)
42200		X=EX*750
42300		WRITE(IOUT, 70)X
42400	70	FORMAT('+ EXEMPTIONS X $750.',F12.2/)
42500		IF(JIT.NE.'Y')GO TO 71
42600		CALL TYP(48,'A')
42700		T48=T46-X
42800		WRITE(IOUT, 71)T48
42900	71	FORMAT('+ TAXABLE INCOME -- ',F12.2/)
43000		T48B=T46B-X
43100		CALL TYP(48,'B')
43200		WRITE(IOUT, 71)T48B
43300	7216	WRITE(IOUT, 72)
43400	72	FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/)
43500		IF(ACC.EQ.0)GO TO 73
43600		TYPE 722
43700	722	FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF 
43800		1SCHEDULES X, Y OR Z.'/)
43900		ACCEPT 1,X,Y,Z
44000		IF(X.EQ.-99)GO TO 142
44100		IF(JIT.NE.'Y')T48=T48B
44200		TAX=X+(T48-Z)*Y/100.
44300	CC	TAXB=X+(T48B-Z)*Y/100.
44400	73	FORMAT('+ YOUR TAX --  ',F12.2/)
44500		CALL TYP(16,I)
44600		WRITE(IOUT,73)TAX
44700	CC	CALL TYP(16,'B')
44800	CC	WRITE(IOUT,73)TAXB
44900	C******  CREDITS ********************
45000	741	FORMAT(' ----- CREDITS'/)
45100		WRITE(IOUT,741)
45200	
45300		IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
45400		WRITE(IOUT,602)
45500		CALL TYP(49,I)
45600	742	FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
45700		WRITE(IOUT,742)
45800		CALL ADUP(RIC)
45900		IF(RIC.EQ.-999)GO TO 1605
46000		IF(RIC.EQ.-99)GO TO 142
46100	743	FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
46200		CALL TYP(50,I)
46300		WRITE(IOUT,743)
46400		CALL ADUP(RIVC)
46500		IF(RIVC.EQ.-99)GO TO 742
46600	744	FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
46700		CALL TYP(51,I)
46800		WRITE(IOUT,744)
46900		CALL ADUP(FTX)
47000		IF(FTX.EQ.-99)GO TO 743
47100	745	FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
47200		CALL TYP(52,I)
47300		WRITE(IOUT,745)
47400		CALL ADUP(CCC)
47500		IF(CCC.EQ.-99)GO TO 744
47600	746	FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
47700		CALL TYP(53,I)
47800		WRITE(IOUT,746)
47900		CALL ADUP(WIC)
48000		IF(WIC.EQ.-99)GO TO 745
48100		CALL TYP(54,I)
48200		T54=RIC+FTX+CCC+WIC+RIVC
48300		WRITE(IOUT,60)T54
48400	C******************************* PAGE 1 AGAIN ***********
48500		WRITE(IOUT,603)
48600	1605	CALL TYP(17,I)
48700		IF(RIC.EQ.-999)RIC=0
48800		WRITE(IOUT, 74)T54
48900	74	FORMAT('+ TOTAL CREDITS.',F12.2/)
49000		T18=TAX-T54
49100		CALL TYP(18,I)
49200		WRITE(IOUT, 75),T18
49300	75	FORMAT('+ ******** INCOME TAX ******',F12.2/)
49400	C********  BACK TO PAGE 2 **************************
49500	760	FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) '/)
49600		IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
49700		WRITE(IOUT,602)
49800		CALL TYP(55,I)
49900		WRITE(IOUT,760)
50000		CALL ADUP(SETX)
50100		IF(SETX.EQ.-999)GO TO 1606
50200		IF(SETX.EQ.-99)GO TO 74
50300	761	FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
50400		CALL TYP(56,I)
50500		WRITE(IOUT,761)
50600		CALL ADUP(TRI)
50700		IF(TRI.EQ.-99)GO TO 760
50800	762	FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
50900		CALL TYP(57,I)
51000		WRITE(IOUT,762)
51100		CALL ADUP(TRW)
51200		IF(TRW.EQ.-99)GO TO 761
51300	763	FORMAT('+ MINIMUM TAX? (FORM 4725) '/)
51400		CALL TYP(58,I)
51500		WRITE(IOUT,763)
51600		CALL ADUP(RMT)
51700		IF(RMT.EQ.-99)GO TO 762
51800	764	FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
51900		CALL TYP(59,I)
52000		WRITE(IOUT,764)
52100		CALL ADUP(SST)
52200		IF(SST.EQ.-99)GO TO 763
52300	765	FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
52400		CALL TYP(60,I)
52500		WRITE(IOUT,765)
52600		CALL ADUP(TIPS)
52700		IF(TIPS.EQ.-99)GO TO 764
52800		CALL TYP(61,I)
52900		T61=TIPS+SST+RMT+TRW+TRI+SETX
53000		WRITE(IOUT,60)T61
53100	
53200	C***** BACK TO PG.1 *******
53300		WRITE(IOUT,603)
53400	1606	CALL TYP(19,I)
53500		IF(SETX.EQ.-999)SETX=0
53600		WRITE(IOUT, 76)T61
53700	76	FORMAT('+ OTHER TAXES (LINE 61). ',F12.2/)
53800		T20T=TAX+T61
53900		CALL TYP(20,I)
54000		WRITE(IOUT, 60)T20T
54100	7721	CALL TYP(21,'A')
54200	77	FORMAT('+ FEDERAL TAX WITHHELD.'/)
54300		WRITE(IOUT, 77)
54400		CALL ADUP(WT)
54500		IF(WT.EQ.-99)GO TO 75
54600		CALL TYP(21,'A')
54700		WRITE(IOUT, 60)WT
54800	78	FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
54900		CALL TYP(21,'B')
55000		WRITE(IOUT, 78)
55100		CALL ADUP(ET)
55200		IF(ET.EQ.-99)GO TO 77
55300	79	FORMAT('+ AMOUNT PAID WITH FORM 4868.  '/)
55400		CALL TYP(21,'C')
55500		WRITE(IOUT, 79)
55600		CALL ADUP(FORM)
55700		IF(FORM.EQ.-99)GO TO 78
55800	80	CALL TYP(21,'D')
55900		WRITE(IOUT, 26)
56000		
56100		IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
56200		WRITE(IOUT,602)
56300	800	FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
56400		CALL TYP(62,I)
56500		WRITE(IOUT,800)
56600		CALL ADUP(FIC)
56700		IF(FIC.EQ.-99)GO TO 78
56800		IF(FIC.EQ.-999)GO TO 1607
56900	801	FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
57000		CALL TYP(63,I)
57100		WRITE(IOUT,801)
57200		CALL ADUP(FUEL)
57300		IF(FUEL.EQ.-99)GO TO 800
57400	802	FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
57500		CALL TYP(64,I)
57600		WRITE(IOUT,802)
57700		CALL ADUP(CRICC)
57800		IF(CRICC.EQ.-99)GO TO 801
57900		T65=FIC+FUEL+CRICC
58000		CALL TYP(65,T54,I)
58100		WRITE(IOUT,60)T65
58200	
58300		WRITE(IOUT,603)
58400	1607	CALL TYP(21,'D')
58500		IF(FIC.EQ.-999)FIC=0
58600		WRITE(IOUT, 26)
58700		IF(ACC.EQ.0)WRITE(IOUT,2)T65
58800		T22=WT+ET+FORM+T65
58900		CALL TYP(22,I)
59000		WRITE(IOUT, 60)T22
59100		T23=T20T-T22
59200		T23T=T23
59300		IF(T23T)T23T=0
59400		CALL TYP(23,I)
59500	82	FORMAT('+ BALANCE DUE. ------ ',F12.2/)
59600		WRITE(IOUT, 82)T23T
59700		T23=-T23
59800		IF(T23)T23=0
59900		CALL TYP(24,I)
60000		WRITE(IOUT, 83)T23
60100	83	FORMAT('+ OVERPAID ---------- ',F12.2)
60200		CALL TYP(25,I)
60300		WRITE(IOUT, 84)T23
60400	84	FORMAT('+ REFUNDED TO YOU --- ',F12.2)
60500		IF(IOUT.EQ.3)CALL EXIT
60600		IF(ACC.EQ.0)GO TO 860
60700		WRITE(IOUT, 85)
60800	85	FORMAT(//' TYPE FILE NAME.  '$)
60900		ACCEPT 4,NAME
61000		CALL OFILE(1,NAME)
61100		WRITE(1)
61200		1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
61300		1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
61400		1 JIT,T61,T65,T54,
61500		1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
61600		1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
61700		1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
61800		WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
61900		1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
62000		1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
62100		1,T23T,T23,K
62200		GO TO 5
62300	201	CALL IFILE(21,NAME)
62400		READ(21)
62500		1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
62600		1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
62700		1 JIT,T61,T65,T54,
62800		1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
62900		1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
63000		1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
63100		READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
63200		1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
63300		1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
63400		1,T23T,T23,K
63500	860	TYPE 86
63600	86	FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
63700		ACCEPT 3,N
63800		IF(N.EQ.'R')GO TO 87
63900		ACC=0
64000		IF(N.EQ.'T')GO TO 4 
64100		IOUT=3
64200		GO TO 4
64300	87	TYPE 88
64400	88	FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN 
64500		1 SCHED. A, 1,11,18,25,30?'/)
64600		ACCEPT 1,X
64700		K=X
64800		IF(K.GT.30)GO TO 89
64900		GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
65000		1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
65100	89	J=K-38
65200		GO TO(27,1,1,1,1)J
65300	C  ABOVE NOT FINISHED.
65400	5	END